home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1998 …ember: Reference Library / Dev.CD Dec 98 RL2.toast / Technical Publications / macosx / Carbon Dater / _Engine Room / lib / Mac / Apps / Launch.pm next >
Encoding:
Text File  |  1998-01-04  |  3.2 KB  |  123 lines  |  [TEXT/ttxt]
  1. #!perl -w
  2. package Mac::Apps::Launch;
  3. require 5.004;
  4. use Exporter;
  5. use Carp;
  6. use strict;
  7. no strict 'refs';
  8. use vars qw($revision $VERSION %Application @ISA @EXPORT);
  9. use Mac::Processes;
  10. use Mac::MoreFiles(%Application);
  11. use Mac::AppleEvents;
  12. #-----------------------------------------------------------------
  13. $VERSION = sprintf("%d.%02d", q$Revision: 1.30 $ =~ /(\d+)\.(\d+)/);
  14. @ISA         = qw(Exporter);
  15. @EXPORT     = qw(LaunchApps QuitApps QuitAllApps);
  16. #-----------------------------------------------------------------
  17. sub QuitAllApps {
  18.     my $warn = 1;
  19.     my $keepapps = 'MACS|McPL|hhgg';
  20.     foreach (@_) {$keepapps .= "|$_"}
  21.     my @apps = ();
  22.     foreach my $psn (keys %Process) {
  23.         my $proc = $Process{$psn};
  24.         my $sig = $proc->processSignature();
  25.         next if ($sig =~ /$keepapps/); # apps to keep running
  26.         push @apps, $sig;
  27.     }
  28.     
  29.     foreach (@apps) {
  30.         my $e = AEBuildAppleEvent(
  31.             'aevt','quit',typeApplSignature,$_,0,0,''
  32.         ) || ($warn = 0);
  33.        AESend($e, kAEWaitReply) || ($warn = 0);
  34.     }
  35.     return $warn;
  36. }
  37. #-----------------------------------------------------------------
  38. sub QuitApps {
  39.     my $warn = 1;
  40.     my @apps = @_;
  41.     foreach (@apps) {
  42.         my $e = AEBuildAppleEvent(
  43.             'aevt','quit',typeApplSignature,$_,0,0,''
  44.         ) || ($warn = 0);
  45.        AESend($e, kAEWaitReply) || ($warn = 0);
  46.     }
  47.     return $warn;
  48. }
  49. #-----------------------------------------------------------------
  50. sub LaunchApps {
  51.     my $warn = 1;
  52.     my $apps = $_[0];
  53.     my $switch;
  54.     if ($_[1] && $_[1] == 1) {
  55.         $switch = eval(launchContinue+launchNoFileFlags)
  56.     } else {
  57.         $switch = eval(launchContinue+launchNoFileFlags+launchDontSwitch)
  58.     }
  59.     foreach (@$apps) {
  60.         if ($Application{$_}) {
  61.             my $Launch = new LaunchParam(
  62.                 launchControlFlags => $switch,
  63.                 launchAppSpec      => $Application{$_}
  64.             );
  65.             LaunchApplication($Launch) || ($warn = 0);
  66.         } else {
  67.             $warn = 0;
  68.         }
  69.     }
  70.     return $warn;
  71. }
  72. #-----------------------------------------------------------------
  73.  
  74. __END__
  75.  
  76. =head1 NAME
  77.  
  78. Mac::Apps::Launch - MacPerl module to launch applications
  79.  
  80. =head1 SYNOPSIS
  81.  
  82.     use Mac::Apps::Launch;
  83.     my @apps = qw(R*ch Arch MPGP);
  84.     LaunchApps([@apps],1) || warn($^E); # launch and switch to front
  85.     LaunchApps([@apps])   || warn($^E); # launch and don't switch 
  86.     QuitApps(@apps)       || warn($^E); # quit @apps
  87.     QuitAllApps(@apps)    || warn($^E); # quit all except @apps
  88.  
  89. =head1 DESCRIPTION
  90.  
  91. Simply launch or quit applications by their creator ID.  The Finder can be quit in this way, though it cannot be launched in this way.
  92.  
  93. This module is used by several other modules.
  94.  
  95. This module as written does not work with MacPerls prior to 5.1.4r4.
  96.  
  97. =head1 EXPORT
  98.  
  99. Exports functions C<QuitApps()>, C<QuitAllApps()>, and C<LaunchApps()>.
  100.  
  101. =head1 HISTORY
  102.  
  103. =over 4
  104.  
  105. =item v.1.3, January 3, 1998
  106.  
  107. General cleanup, rewrite of method implementation, no longer support versions prior to 5.1.4r4, addition of Quit methods, methods return undef on failure (most recent error in C<$^E>, but could be multiple errors; oh well).
  108.  
  109. =back
  110.  
  111. =head1 AUTHOR
  112.  
  113. Chris Nandor F<E<lt>pudge@pobox.comE<gt>>
  114. http://pudge.net/
  115.  
  116. Copyright (c) 1998 Chris Nandor.  All rights reserved.  This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.  Please see the Perl Artistic License.
  117.  
  118. =head1 VERSION
  119.  
  120. Version 1.30 (03 January 1998)
  121.  
  122. =cut
  123.